Shareware Super Platinum 8/Shareware Super Platinum 8.iso/mac/PROGTOOL/DDPLUS63.ZIP;1/COMIO.PAS

Pascal/Delphi Source File | 1994-03-24 | 5.6 KB | 250 lines

unit comio;
{$V-,S-,R-}

interface

uses ddfossil, async2;

procedure AsyncSelectPort(n: byte);
procedure AsyncSendChar(ch: char);
procedure AsyncReceiveChar(var ch: char);
function  AsyncCarrierPresent: boolean;
function  AsyncCharPresent: boolean;
procedure AsyncSelectFossil;
procedure AsyncSelectInternal;
procedure AsyncCloseUp;
procedure AsyncCloseCom(cp : byte);
procedure AsyncSetBaud(n: longint);
procedure AsyncSetDTR(state: boolean);
procedure AsyncFlushOutput;
procedure AsyncPurgeOutput;
procedure AsyncSendString(s: string);
procedure AsyncSetFlow(SoftTran,Hard,SoftRecv: boolean);
Procedure AsyncBufferStatus(var Insize,infree,outsize,outfree: word);
Procedure SetUpPorts;
Procedure LoadPorts  (var port1,port2,port3,port4: word;
                      var irq1,irq2,irq3,irq4 : byte);
Procedure ResetPorts (var port1,port2,port3,port4: word;
                      var irq1,irq2,irq3,irq4 : byte);

type
 AsyncIoTypes=(Fossil,Internal,Bios);
var
 AsyncIoType: AsyncIotypes;
 {comport: word; }
 initok, X00extOk,Y00extOk  : boolean;
 internalinsize,internaloutsize: word;

implementation

procedure AsyncSelectPort(n: byte);
var
 b: boolean;
begin;
 comport:=n;
 case AsyncIoType of
   Fossil: If x00extok then
             begin
               port_num:=n-1;
               initok:=true;
              end
            else
              begin
                async_deinit_fossil;
                port_num:=n-1;
                initok:=async_init_fossil;
              end;
            {
            begin
              port_num:=n-1;
              initok:=true;
              async_reset_x00_ext;
            end;
            }
  Internal: begin;
             closeallcoms;
             initok:=opencom(n,InternalInSize,InternalOutSize);
            end;
 end;
end;

procedure AsyncSendChar(ch: char);
begin;
 case AsyncIoType of
  Fossil: async_send(ch);
  Internal: begin
              While CTSStat(comport) or RTSstat(comport) do
                If Not AsyncCarrierPresent then
                     halt;
               ComWriteChw(comport,ch);
            end;
 end;
end;

procedure AsyncReceiveChar(var ch: char);
var
 b: boolean;
begin;
 case asyncIotype of
  Fossil: b:=async_receive(ch);
  Internal: ch:=ComReadCh(comport);
 end;
end;

function AsyncCarrierPresent: boolean;
begin;
 case asyncIoType of
  Fossil: AsyncCarrierPresent:=async_carrier_present;
  Internal: AsyncCarrierPresent:=DCDStat(comport);
 end;
end;

function AsyncCharPresent: boolean;
begin;
 case asyncIoTYpe of
  Fossil: asyncCharPresent:=Async_buffer_check;
  Internal: asynccharpresent:=combufferleft(comport,'I')<>c_insize[comport];
 end;
end;

procedure AsyncSelectFossil;
begin;
 AsyncIoType:=Fossil;
end;

procedure AsyncCloseUp;
begin;
 case AsyncIoType of
  fossil: Async_deinit_fossil;
  internal: closeallcoms;
 end;
end;

procedure AsyncCloseCom;
begin;
 case AsyncIoType of
  fossil:   Async_deinit_fossil;
  {
    async_reset_x00_ext(n);
  }
  internal: closecom(cp);
 end;
end;

procedure AsyncSetBaud(n: longint);
begin;
 case asynciotype of
  fossil:   If not X00extok then async_set_baud(n);
  {
    async_set_x00_ext(n);
  }
  internal: comparams(comport,n,8,'N',1);
 end;
end;

procedure AsyncSelectInternal;
begin;
 AsyncIOType:=Internal;
end;

procedure AsyncSetDTR(state: boolean);
begin;
 case AsyncIOType of
  Fossil:   async_set_dtr(state);
  Internal: SetDTR(comport,state);
 end;
end;

procedure AsyncFlushOutput;
begin;
 case AsyncIOType of
  Fossil:   async_flush_output;
  Internal: ComWaitForClear(comport);
 end;
end;

procedure AsyncPurgeOutput;
begin;
 case AsyncIOType of
  Fossil:   async_purge_output;
  Internal: ClearCom(comport,'O');
 end;
end;

procedure AsyncSendString(s: string);
var
 a: integer;
begin;
 for a:=1 to length(s) do AsyncSendChar(s[a]);
end;

procedure AsyncSetFlow(SoftTran,Hard,SoftRecv: boolean);
begin;
 {*srl}
 case AsyncIOType of
  Fossil:   async_set_flow(softtran,hard,softrecv);
  Internal: begin;
              SetCTSMode(comport,hard);
              SetRTSMode(comport,hard,C_RTSOn[comport],C_RTSOff[comport]);
              SoftHandShake(comport,softtran,'A','A');
             end;
 end;
end;

Procedure AsyncBufferStatus(var Insize,infree,outsize,outfree: word);
begin;
 case asynciotype of
  fossil: async_buffer_Status(insize,infree,outsize,outfree);
  internal: begin;
             insize:=internalinsize;
             outsize:=internaloutsize;
             infree:=combufferleft(comport,'I');
             outfree:=combufferleft(comport,'O');
            end;
 end;
end;

Procedure SetUpPorts;
var
  i : byte;
begin
 for i := 1 to 4 do
    begin
      C_PortAddr[i] := D_PortAddr[i];
      C_PortInt[i]  := D_PortInt[i];
    end;
end;

Procedure LoadPorts (var port1,port2,port3,port4: word;
                     var irq1,irq2,irq3,irq4 : byte);
begin
 port1 :=  D_PortAddr[1];
 irq1  :=  D_PortInt[1];
 port2 :=  D_PortAddr[2];
 irq2  :=  D_PortInt[2];
 port3 :=  D_PortAddr[3];
 irq3  :=  D_PortInt[3];
 port4 :=  D_PortAddr[4];
 irq4  :=  D_PortInt[4];
end;

Procedure ResetPorts (var port1,port2,port3,port4: word;
                      var irq1,irq2,irq3,irq4 : byte);
begin
  C_PortAddr[1] := port1;
  C_PortInt[1]  := irq1;
  C_PortAddr[2] := port2;
  C_PortInt[2]  := irq2;
  C_PortAddr[3] := port3;
  C_PortInt[3]  := irq3;
  C_PortAddr[4] := port4;
  C_PortInt[4]  := irq4;
end;

begin;
 AsyncIoType:=Internal;
 comport:=1;
 internalinsize :=2048;
 internaloutsize:=2048;
end.